home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
win
/
pascal
/
winplay.exe
/
WINPLAY.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-12-17
|
11KB
|
326 lines
unit WinPlay;
(*
I'll make a confession that may shame me in front of my fellow
TurboPascal programmers: I used to enjoy using the Play statement in
GW-BASIC. It provided a pretty sensible way to get a musical phrase
out of a program. Certainly it was easier to use than TP's Sound
command, and much easier to use than the TPW Windows API calls that
deal with musical notes.
Here, then, is WinPlay, a TPW unit that emulates that BASIC command.
It makes it a snap to drop a musical phrase into a TPW program.
The syntax is simple: just give Play() a string consisting of note
names. Optionally you can specify things like octaves, tempo, note
types (like quarter, sixteenth, etc.), "music" type (like legato,
staccato, and normal), and a few other goodies.
In that Play string:
A..G : are the note names, as if on a keyboard.
P : means pause, or rest.
#,+ : mean sharp the immediately previous note.
- : means flat the immediately previous note.
. : means dot the immediately previous note.
Tnnn : tempo, sets the number of quarter notes in one
minute. Default is T120.
On : octave, sets the current octave, 0 through 6, that the
note names refer to. Default is O4, where C is an
octave above middle C. Pitches in an octave begin at
C and work upwards to B.
Lnn : length, sets the duration of notes that follow. 'n'
usually is a common note type like 8 for eighths, 4
for quarters, 1 for whole notes, etc. It may be any
number. Musician friends will giggle at you if you
program in 15th or 57th notes. 3, 6, and 12 might
commonly be used for triplets, though. Default is L4.
nn : a number following a note name or a pause means 'for
this specific instance only, set a temporary length.'
MS
MN
ML : "music" types of staccato, normal, or legato.
In staccato mode, the pitch is sounded for half the
indicated length followed by a rest of half the
length. In normal mode, the default, the ratio is 7/8
to 1/8. In legato mode, there is no articulating rest
-- repeated notes will not be distinguishable.
>
< : shorthand indicators to change up or down from the
current octave.
(A few commands from BASIC are not supported: N, X, V, MF, and MB.)
Case of the letters makes no difference. Embedded spaces, which can
make things much more readable, are ignored.
This simple example will play a G major scale starting in default
octave 4, at default quarter-note length, at default 120 tempo:
Play ('gab>cdef#g');
Careful perusal of the accompanying file, CELLO.PAS, a setting of a
movement from the Bach G Major Solo Suite for 'cello, will show all
the tricks in use.
The following source code is pretty liberally commented with some
oddities about using the Windows API sound functions. *)
interface
procedure Play (PlayString : string);
implementation
uses WinProcs, WinCRT;
const Magic : integer=376;
(*
Magic is used as a multiplier to determine the duration of a
note. The Windows API documentation for setVoiceSound
indicates that duration should be a straight forward
calculation of yea-so-many clock ticks. It just isn't so.
Brute force experimentation found 376. It seems to work fine
regardless of processor speed or whatever. I've tested on
386/33, 386/16, and 8088/4.7 machines -- they all work. Let
me tell you, it was sure fun setting up and running Windows on
that 8088/4.7 CGA equipment. *)
Tempo : integer = 120;
NoteType : integer = 4;
Octave : integer = 4;
Music : char = 'N';
C : integer = 0;
D : integer = 2;
E : integer = 4;
F : integer = 5;
G : integer = 7;
A : integer = 9;
B : integer = 11;
Pause : integer = $ff;
Base : array [0..6] of integer = (1,13,25,37,49,61,73);
var Pitch : array[0..84] of LongInt;
Herz : array[0..11] of Real;
SemiTone,Count,Multiplier,Power : integer;
Divisor : real;
procedure Play;
var p : integer;
AddDot : Boolean;
function GetNumber: integer;
var N,ErrorCode: integer;
S: string[4];
begin
N := 0;
S := '';
inc(p);
repeat
S := S + PlayString[p];
Inc(p);
until not (UpCase(PlayString[p]) in ['0'..'9'])
or (p > length(PlayString));
val(S,N,ErrorCode);
GetNumber := N;
dec(p);
end;
function Duration(Tempo,NoteType : integer) : integer;
var Temp : real;
begin
Temp := 60 / Tempo * Magic * 4 / NoteType;
If AddDot then Temp := Temp + Temp / 2;
Duration := trunc(Temp);
end;
procedure SetNote(Note : integer);
var SingleLength : boolean;
SaveNoteType : integer;
begin
SingleLength := false;
AddDot := false;
if p<length(PlayString) then
if PlayString[p+1] in ['#','+','-'] then
begin
inc(p);
case PlayString[p] of
'#','+' : inc(Note);
'-' : dec(Note);
end;
end;
if p<length(PlayString) then
if PlayString[p+1] in ['0'..'9'] then
begin
SaveNoteType := NoteType;
NoteType := GetNumber;
SingleLength := true;
end;
if p<length(PlayString) then
if PlayString[p+1] = '.' then
begin
AddDot := true;
inc(p);
end;
(*
The actual tone production routines follow. If you've explored
the API music functions at all, you may wonder why I'm using
setVoiceSound instead of setVoiceNote. setVoiceNote seems, on the
surface, to be the automatic way to write these sorts of things,
but it just doesn't work very well. Whole notes and half notes
are incorrectly produced, dots are impossible, and the nicety of
having legato is gone. setVoiceSound works much better, though it
does require that you calculate a duration rather than just
specifying tempo and length. *)
if Note = Pause then setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType))
else
Case Music of
'N' : begin
setVoiceSound(1,Pitch[Base[Octave]+Note],
Duration(Tempo,NoteType) * 7 div 8 );
setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType) * 1 div 8 );
end;
'S' : begin
setVoiceSound(1,Pitch[Base[Octave]+Note],
Duration(Tempo,NoteType) * 4 div 8 );
setVoiceSound(1,Pitch[0],Duration(Tempo,NoteType) * 4 div 8 );
end;
'L' : setVoiceSound(1,Pitch[Base[Octave]+Note],Duration(Tempo,NoteType));
end;
if SingleLength then NoteType := SaveNoteType;
end; {SetNote}
begin {Play main body}
repeat for p := 1 to length (PlayString) do
if PlayString[p] = ' ' then Delete (PlayString,p,1);
until pos(' ',PlayString) = 0;
OpenSound;
p := 1;
repeat
Case UpCase(PlayString[p]) of
'T' : Tempo := GetNumber;
'O' : Octave := GetNumber;
'L' : NoteType := GetNumber;
'M' : begin
inc(p);
Music := UpCase(PlayString[p]);
end;
'A' : SetNote(A);
'B' : SetNote(B);
'C' : SetNote(C);
'D' : SetNote(D);
'E' : SetNote(E);
'F' : SetNote(F);
'G' : SetNote(G);
'P' : SetNote(pause);
'>' : Inc(Octave);
'<' : Dec(Octave);
end; {Case}
inc(p);
until p > length (PlayString);
(*
I don't know why I've got to send one last 'empty' note to the
voice queue, but without it, the last real note doesn't get played.
That's the purpose of the next statement. *)
setVoiceSound(1,0,1);
setVoiceThreshold(1,0);
StartSound;
repeat until GetThresholdSt